home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib14.dsk / AUTO SCREEN.bas < prev    next >
BASIC Source File  |  2023-02-26  |  10KB  |  163 lines
  1. 10  REM  **********************
  2. 11  REM  *    AUTO SCREEN     *
  3. 12  REM  *    BY DON RAVEY    *
  4. 13  REM  * COPYRIGHT (C) 1983 *
  5. 14  REM  * BY MICROSPARC, INC *
  6. 15  REM  * LINCOLN, MA. 01773 *
  7. 16  REM  **********************
  8. 20  DIM SI$(20),SA$(20)
  9. 30 Q$ =  CHR$(34):D$ =  CHR$(4)
  10. 99  GOTO 199: REM  ::SUBROUTINES:
  11. 100  VTAB 23: INVERSE : PRINT "       PRESS ANY KEY TO CONTINUE..     ": NORMAL 
  12. 101  WAIT  -16384,128,1: POKE  -16368,0: RETURN 
  13. 102  PRINT ST$;" (Y/N) ";: GET A$: PRINT A$:YES = A$ = "Y": RETURN 
  14. 109  REM  ** GET A STRING WITH ** EXACTLY THE CHARACTERS ** ENTERED, INCL. COMMAS ** AND QUOTES...
  15. 110  POKE  -16368,0:S$ = "":HT = 1
  16. 112  FLASH : PRINT " ";: NORMAL :K =  PEEK( -16384): IF K <128  THEN  POKE 36, PEEK(36) -1: GOTO 112
  17. 114 K = K -128: IF K = 13  THEN  POKE 36, PEEK(36) -1: CALL  -868: PRINT : GOTO 120
  18. 116  IF (K = 8  OR K = 21)  AND  LEN(S$) <2  THEN S$ = "": HTAB HT: CALL  -868: POKE  -16368,0: GOTO 112
  19. 117  IF K = 8  THEN S$ =  LEFT$(S$, LEN(S$) -1): POKE 36, PEEK(36) -2: CALL  -868: POKE  -16368,0: GOTO 112
  20. 118 S$ = S$ + CHR$(K): POKE 36, PEEK(36) -1: PRINT  CHR$(K);: POKE  -16368,0: GOTO 112
  21. 120  RETURN 
  22. 149  REM  ** MOVE THE INVERSE ** CURSOR FROM ITEM 'OS' ** TO ITEM 'CS'...
  23. 150  VTAB HL +2 +OS +OS *(S <10): HTAB HT: PRINT SI$(OS)
  24. 152  VTAB HL +2 +CS +CS *(S <10): INVERSE : HTAB HT: PRINT SI$(CS): NORMAL 
  25. 154  RETURN 
  26. 199  REM  ::::MAIN PROGRAM::::
  27. 200 AS$ = "****************************************"
  28. 202 BS$ = "*                                      *"
  29. 300  TEXT : HOME : PRINT AS$;BS$;
  30. 310  PRINT "*        SELECTION SCREEN MAKER        *";
  31. 320  PRINT BS$;"*            BY DON RAVEY              *";BS$;AS$
  32. 330  VTAB 14: HTAB 6:ST$ = "WANT INSTRUCTIONS? ": GOSUB 102
  33. 340  IF   NOT YES  THEN 1000
  34. 350  HOME : HTAB 9: INVERSE : PRINT " SELECTION SCREEN MAKER ": NORMAL 
  35. 360  PRINT : PRINT "THIS PROGRAM WILL CREATE A TEXT FILE    CONTAINING A 'SELECTION MENU' ROUTINE   WHICH CAN BE 'EXEC'D INTO YOUR APPLESOFTPROGRAM.": PRINT 
  36. 380  PRINT "YOU MAY CHOOSE TO HAVE A HEADER AT THE  TOP OF YOUR SELECTION SCREEN OR NOT.    SELECTIONS WILL BE MADE BY USE OF THE   LEFT AND RIGHT ARROW KEYS, AS EXPLAINED"
  37. 390  PRINT "AT THE BOTTOM OF YOUR SELECTION SCREEN.": PRINT 
  38. 400  PRINT "YOU WILL BE ASKED FOR 'SELECTION ITEMS' (SUCH AS PROGRAM NAMES, OR NAMES OF     CHOICES IN YOUR PROGRAM) ... AND FOR"
  39. 410  PRINT "'ACTION' COMMANDS FOR EACH ITEM (EXACTLYAS YOU WOULD ENTER THEM INTO PROGRAM    LINES .. ";: INVERSE : PRINT "GOTO 550";: NORMAL : PRINT ", OR ";: INVERSE : PRINT "PRINT ";Q$;" RUN ABC";Q$;: NORMAL : PRINT ","
  40. 420  PRINT "INCLUDING CONTROL CHARACTERS,  SUCH AS  CONTROL-D FOR DOS COMMANDS, ETC."
  41. 450  GOSUB 100: HOME : GOTO 1000
  42. 500  REM 
  43. 999  REM  ** PROMPTS FOR LINE NO. ** VALUES AND HEADER ** LINES...
  44. 1000  VTAB 9: CALL  -958: PRINT "A ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT " ACCEPTS THE DEFAULT VALUE..."
  45. 1010  VTAB 11: PRINT "STARTING LINE # FOR YOUR ROUTINE: 9000";: POKE 36, PEEK(36) -4
  46. 1020 LS = 9000: INPUT "";LS$
  47. 1030  IF  LEN(LS$) >0  THEN LS =  VAL(LS$)
  48. 1040  VTAB 11: HTAB 35: CALL  -868: PRINT LS
  49. 1050 LN = LS: IF LS = 0  THEN 1010
  50. 1060  VTAB 13: PRINT "LINE # INCREMENTS: 10";: POKE 36, PEEK(36) -2
  51. 1070 LI = 10: INPUT "";LI$
  52. 1080  IF  LEN(LI$) >0  THEN LI =  VAL(LI$)
  53. 1090  VTAB 13: HTAB 20: CALL  -868: PRINT LI
  54. 1100  IF LI = 0  THEN 1060
  55. 1110 HL = 0: VTAB 15: PRINT "DO YOU WANT HEADER LINE(S) CENTERED AT"
  56. 1120 ST$ = "THE TOP OF YOUR SCREEN? ": GOSUB 102
  57. 1130  IF   NOT YES  THEN 2000
  58. 1140  VTAB 18: PRINT "ENTER EACH HEADER LINE, FOLLOWED BY A"
  59. 1150  INVERSE : PRINT "RETURN";: NORMAL : PRINT ". AFTER THE LAST LINE JUST ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT ".": PRINT 
  60. 1160 HT = 1
  61. 1170  GOSUB 110:HL$(HL) = S$: IF  LEN(HL$(HL)) < >0  THEN HL = HL +1:S$ = "": GOTO 1170
  62. 1180  FOR X = 0 TO HL:X$ = "": FOR Y = 1 TO (41 - LEN(HL$(X)))/2:X$ = X$ +" ": NEXT Y:HL$(X) = X$ +HL$(X) +X$:HL$(X) =  LEFT$(HL$(X),40): NEXT X
  63. 1900  REM 
  64. 1999  REM  ** GET EACH SELECTION ** ITEM AND THE ACTION ** COMMANDS..
  65. 2000  HOME : IF HL < >0  THEN  INVERSE : FOR X = 0 TO HL -1: PRINT HL$(X);: NEXT X: NORMAL : PRINT 
  66. 2010 S = 1
  67. 2020  VTAB HL +2: HTAB 1: CALL  -958: PRINT "ENTER SELECTION ITEM NO. ";S;":": PRINT 
  68. 2030  GOSUB 110:SI$(S) = S$: PRINT 
  69. 2040  IF  LEN(SI$(S)) = 0  THEN S = S -1: GOTO 3000
  70. 2050  PRINT "ENTER THE EXACT COMMAND(S) THAT SHOULD  BE EXECUTED IF THIS SELECTION IS MADE.. (E.G., ";: INVERSE : PRINT "GOTO 550";: NORMAL : PRINT " OR ";: INVERSE : PRINT "PRINT ";Q$;" BRUN XYZ";Q$;: NORMAL : PRINT " ..."
  71. 2060  PRINT "DON'T FORGET THE CONTROL-D FOR DOS!)": PRINT 
  72. 2070  GOSUB 110:SA$(S) = S$: REM  GET THE EXACT LINE, VERBATIM
  73. 2080 S = S +1: GOTO 2020
  74. 2090  REM 
  75. 3000  REM  'CENTER' THE DISPLAYS:
  76. 3010  FOR X = 1 TO S: IF  LEN(SI$(X)) >HM  THEN HM =  LEN(SI$(X)): NEXT 
  77. 3020 HT =  INT(20 -HM/2) +(HM = 0)
  78. 4000  REM  ::::DISPLAY::::
  79. 4010  TEXT : HOME : IF HL  THEN  INVERSE : FOR X = 0 TO HL -1: PRINT HL$(X);: NEXT : NORMAL : PRINT 
  80. 4020 CS = 1: REM  CURRENT SELECTION
  81. 4030  FOR X = 1 TO S: IF X = CS  THEN  INVERSE 
  82. 4040  VTAB HL +2 +X +X *(S <10)
  83. 4050  HTAB HT: PRINT SI$(X): NORMAL 
  84. 4060  NEXT 
  85. 4070  VTAB 23: INVERSE : PRINT "<-";: NORMAL : PRINT " ";: INVERSE : PRINT "->";: NORMAL : PRINT " TO SELECT .... ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT " TO EXECUTE."
  86. 4080  VTAB 24: HTAB 3: FLASH : PRINT "C";: NORMAL : PRINT " TO CHANGE ... ";: FLASH : PRINT "ESC";: NORMAL : PRINT " TO ACCEPT.";
  87. 4090  POKE  -16368,0
  88. 4100 K =  PEEK( -16384): IF K <128  THEN 4100
  89. 4110  POKE  -16368,0:K = K -128: IF K < >8  AND K < >21  AND K < >13  AND K < >27  AND K < >67  THEN 4100: REM  THE ONLY ACCEPTABLE KEYS
  90. 4120  VTAB 21: HTAB 1: CALL  -868
  91. 4130 OS = CS
  92. 4140  IF K = 8  THEN CS = CS -1:CS = CS *(CS >0) +S *(CS = 0): GOSUB 150: GOTO 4100: REM  LEFT-ARROW
  93. 4150  IF K = 21  THEN CS = CS +1:CS = CS *(CS < = S) +(CS = S +1): GOSUB 150: GOTO 4100: REM   RIGHT-ARROW
  94. 4160  IF K = 13  THEN  VTAB 21: PRINT " ";SA$(CS): GOTO 4100: REM  C.R.
  95. 4170  IF K = 27  THEN 6000: REM  'ESC' - WRITE THE FILE
  96. 4180  REM  K MUST BE 67 ('C')...
  97. 4190  HOME : VTAB 22: INVERSE : PRINT "CR";: NORMAL : PRINT " ACCEPTS LINE .. OR ENTER NEW LINE..."
  98. 4200  VTAB 4: HTAB HT: PRINT SI$(CS): VTAB 7: HTAB HT: PRINT SA$(CS)
  99. 4210  VTAB 4: FLASH : HTAB HT: PRINT  LEFT$(SI$(CS),1);: NORMAL 
  100. 4220 K =  PEEK( -16384): IF K <128  THEN 4220
  101. 4230  POKE  -16368,0: HTAB HT: CALL  -868: IF K = 128 +13  THEN  PRINT SI$(CS): GOTO 4270
  102. 4240  PRINT  CHR$(K -128);: FLASH : PRINT " ";: NORMAL : POKE 36,HT +1:S$ =  CHR$(K -128)
  103. 4250 K =  PEEK( -16384): IF K <128  THEN 4250
  104. 4260  POKE  -16368,0: GOSUB 114:SI$(CS) = S$
  105. 4270  POKE  -16368,0: VTAB 4: HTAB HT: PRINT SI$(CS)
  106. 4280  VTAB 7: FLASH : HTAB HT: PRINT  LEFT$(SA$(CS),1);: NORMAL 
  107. 4290 K =  PEEK( -16384): IF K <128  THEN 4290
  108. 4300  POKE  -16368,0: HTAB HT: CALL  -868: IF K = 128 +13  THEN  PRINT SA$(CS): GOTO 4340
  109. 4310  PRINT  CHR$(K -128);: FLASH : PRINT " ";: NORMAL : POKE 36,HT +1:S$ =  CHR$(K -128)
  110. 4320 K =  PEEK( -16384): IF K <128  THEN 4320
  111. 4330  POKE  -16368,0: GOSUB 114:SA$(CS) = S$
  112. 4340  VTAB 7: HTAB 1: PRINT SA$(CS)
  113. 4350  GOTO 4000
  114. 5999  END 
  115. 6000  REM  :::WRITE THE FILE:::
  116. 6010  HOME : VTAB 10: HTAB 3: INVERSE : PRINT " CREATING TEXT FILE:   SELECT.SEG ": NORMAL 
  117. 6020  PRINT D$"OPEN SELECT.SEG"
  118. 6030  PRINT D$"CLOSE"
  119. 6040  PRINT D$"DELETE SELECT.SEG"
  120. 6050  PRINT D$"OPEN SELECT.SEG"
  121. 6060  PRINT D$"WRITE SELECT.SEG"
  122. 6070  IF S >10  THEN  PRINT LN;"ONERR GOTO";LN +LI *2:LN = LN +LI
  123. 6080  IF S >10  THEN  PRINT LN;"DIMSI$(";S;")":LN = LN +LI
  124. 6090  PRINT LN;"POKE216,0:HT=";HT;":SN=";S;":Q$=CHR$(34)";: IF HL  THEN  PRINT ":HL=";HL;
  125. 6100  PRINT 
  126. 6110  IF   NOT HL  THEN 6190
  127. 6120  FOR X = 0 TO HL -1:S$ = "":LN = LN +LI
  128. 6130  FOR Y = 1 TO  LEN(HL$(X)):CQ$ =  MID$ (HL$(X),Y,1): IF CQ$ = Q$  THEN S$ = S$ +Q$ +"+Q$+" +Q$: GOTO 6150
  129. 6140 S$ = S$ +CQ$
  130. 6150  NEXT Y
  131. 6160  PRINT LN;"HL$(";X;")=";Q$;S$;Q$
  132. 6170  NEXT X
  133. 6190  FOR X = 1 TO S:S$ = "":LN = LN +LI
  134. 6200  FOR Y = 1 TO  LEN(SI$(X)):CQ$ =  MID$ (SI$(X),Y,1): IF CQ$ = Q$  THEN S$ = S$ +Q$ +"+Q$+" +Q$: GOTO 6220
  135. 6210 S$ = S$ +CQ$
  136. 6220  NEXT Y
  137. 6230  PRINT LN;"SI$(";X;")=";Q$;S$;Q$
  138. 6240  NEXT X
  139. 6250 LN = LN +LI: PRINT LN;"TEXT:HOME"
  140. 6260  IF HL  THEN LN = LN +LI: PRINT LN;"INVERSE:FORX=0TOHL-1:PRINTHL$(X);:NEXTX:PRINT:NORMAL"
  141. 6270 LN = LN +LI: PRINT LN;"CS=1"
  142. 6280 LN = LN +LI: PRINT LN;"FORX=1TOSN:IFX=CSTHENINVERSE"
  143. 6290 LN = LN +LI: PRINT LN;"VTABHL+2+X+X*(SN<10):HTABHT:PRINTSI$(X):NORMAL"
  144. 6300 LN = LN +LI: PRINT LN;"NEXTX"
  145. 6310 X$ = "VTAB23:INVERSE:PRINT" +Q$ +"<-" +Q$ +";:NORMAL:PRINT" +Q$ +" " +Q$ +";:INVERSE:PRINT" +Q$ +"->" +Q$ +";:NORMAL"
  146. 6320 X$ = X$ +":PRINT" +Q$ +" TO SELECT .... " +Q$ +";:INVERSE:PRINT" +Q$ +"RETURN" +Q$ +";:NORMAL:PRINT" +Q$ +" TO EXECUTE." +Q$
  147. 6330 LN = LN +LI: PRINT LN;X$
  148. 6340 LN = LN +LI: PRINT LN;"POKE-16368,0"
  149. 6350 LN = LN +LI: PRINT LN;"K=PEEK(-16384):IFK<128THEN";LN
  150. 6360 LN = LN +LI: PRINT LN;"POKE-16368,0:K=K-128:IFK<>8ANDK<>21ANDK<>13THEN";LN -LI
  151. 6370 LN = LN +LI: PRINT LN;"OS=CS"
  152. 6380 LN = LN +LI: PRINT LN;"IFK=8THENCS=CS-1:CS=CS*(CS>0)+SN*(CS=0):GOSUB";LN +LI +(2 +S) *LI;":GOTO";LN -3 *LI
  153. 6390 LN = LN +LI: PRINT LN;"IFK=21THENCS=CS+1:CS=CS*(CS<=SN)+(CS=SN+1):GOSUB";LN +LI +(1 +S) *LI;":GOTO";LN -4 *LI
  154. 6400 LN = LN +LI: PRINT LN;"ONCSGOSUB";LN +LI;:LN = LN +LI
  155. 6410  FOR X = 1 TO S -1:LN = LN +LI: PRINT ",";LN;: NEXT X: PRINT ":GOTO";LS +HL *LI +S *LI +LI
  156. 6420 LN = LN -S *LI: FOR X = 1 TO S:LN = LN +LI: PRINT LN;SA$(X);":RETURN": NEXT X
  157. 6430 LN = LN +LI: PRINT LN;"VTABHL+2+OS+OS*(SN<10):HTABHT:PRINTSI$(OS)"
  158. 6440 LN = LN +LI: PRINT LN;"VTABHL+2+CS+CS*(SN<10):INVERSE:HTABHT:PRINTSI$(CS):NORMAL:RETURN"
  159. 6450  PRINT D$"CLOSE"
  160. 6460  VTAB 10: CALL  -868: HTAB 17: PRINT "D O N E"
  161. 6470  VTAB 13: PRINT "YOUR SELECTION SCREEN PROGRAM SEGMENT   IS CONTAINED IN THE FILE ";Q$;"SELECT.SEG";Q$;"."
  162. 6480  VTAB 16: PRINT "YOU CAN 'EXEC SELECT.SEG' INTO YOUR     TARGET PROGRAM.  IT WILL OCCUPY LINE    NUMBERS ";: INVERSE : PRINT LS;: NORMAL : PRINT " TO ";: INVERSE : PRINT LN;: NORMAL : PRINT "."
  163. 6490  END